www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\inc\jpeg_draw.asp

    <%


'**************************************************************
' 新动软网站管理系统
' 官方网站: http://www.aspcpu.com
' 系统作者: 阮丁远(网名：天下程序)
' Copyright 新动软网站管理系统 版权所有
'**************************************************************


%>



<%

dir_set="../"


%>




<!--#include file=config.asp-->
<!--#include file=conn.asp-->

<%
biao2="[ND_sys]"
biao3="[ND_admin]"



set rs22=server.CreateObject("adodb.recordset")
rs22.open "select top 1 * from "&biao2&" where type='config_settings'",conn,1,1
if rs22.eof then
shuiyin_on=0
shuiyin_cont="www.aspcpu.com"

else

ddd1=rs22("data")
dddd12=split(ddd1,"|")

'是否开启图片水印,0=不开启，1=开启
shuiyin_on=cstr(dddd12(0))
'图片水印文字
shuiyin_cont=cstr(dddd12(1))

end if


'图片水印文字字体大小 
shuiyin_z_size=21
'图片水印文字颜色
shuiyin_z_color=&Hf3344ff


%>




<%
Class qswhImg
dim aso
Private Sub Class_Initialize
set aso=CreateObject("Adodb.Stream")
aso.Mode=3 
aso.Type=1 
aso.Open 
End Sub
Private Sub Class_Terminate
set aso=nothing
End Sub

Private Function Bin2Str(Bin)
Dim I, Str
For I=1 to LenB(Bin)
   clow=MidB(Bin,I,1)
   if ASCB(clow)<128 then
    Str = Str & Chr(ASCB(clow))
   else
    I=I+1
    if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
   end if
Next 
Bin2Str = Str
End Function

Private Function Num2Str(num,base,lens)
'qiushuiwuhen (2002-8-12)
dim ret
ret = ""
while(num>=base)
   ret = (num mod base) & ret
   num = (num - num mod base)/base
wend
Num2Str = right(string(lens,"0") & num & ret,lens)
End Function

Private Function Str2Num(str,base)
'qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i=1 to len(str)
   ret = ret *base + cint(mid(str,i,1))
next
Str2Num=ret
End Function

Private Function BinVal(bin)
'qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i = lenb(bin) to 1 step -1
   ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal=ret
End Function

Private Function BinVal2(bin)
'qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i = 1 to lenb(bin)
   ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal2=ret
End Function

Function getImageSize(filespec) 
'qiushuiwuhen (2002-9-3)
dim ret(3)
aso.LoadFromFile(filespec)
bFlag=aso.read(3)
select case hex(binVal(bFlag))
case "4E5089":
   aso.read(15)
   ret(0)="PNG"
   ret(1)=BinVal2(aso.read(2))
   aso.read(2)
   ret(2)=BinVal2(aso.read(2))
case "464947":
   aso.read(3)
   ret(0)="GIF"
   ret(1)=BinVal(aso.read(2))
   ret(2)=BinVal(aso.read(2))
case "535746":
   aso.read(5)
   binData=aso.Read(1)
   sConv=Num2Str(ascb(binData),2 ,8)
   nBits=Str2Num(left(sConv,5),2)
   sConv=mid(sConv,6)
   while(len(sConv)<nBits*4)
    binData=aso.Read(1)
    sConv=sConv&Num2Str(ascb(binData),2 ,8)
   wend
   ret(0)="SWF"
   ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
   ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
case "FFD8FF":
   do 
    do: p1=binVal(aso.Read(1)): loop while p1=255 and not aso.EOS
    if p1>191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2)
    do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS
   loop while true
   aso.Read(3)
   ret(0)="JPG"
   ret(2)=binval2(aso.Read(2))
   ret(1)=binval2(aso.Read(2))
case else:
   if left(Bin2Str(bFlag),2)="BM" then
    aso.Read(15)
    ret(0)="BMP"
    ret(1)=binval(aso.Read(4))
    ret(2)=binval(aso.Read(4))
   else
    ret(0)=""
   end if
end select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
getimagesize=ret
End Function
End Class






 function do_shuiying(SavefullPath)






if shuiyin_on<>0 then


'SavefullPath="326151745wldn.jpg" 


    '取得图片的宽度
    Set qswh = new qswhImg
    arr = qswh.getImageSize(Server.Mappath(SavefullPath))
    Set qswh = Nothing
    str_ImgWidth=arr(1)
    str_ImgHeight=arr(2)
    If Int(str_ImgWidth) > 600 Then
     str_ImgWidth = 600
    Else
     str_ImgWidth = str_ImgWidth
    End If
    '加水印
    If Int(str_ImgWidth) > 200 And Int(str_ImgHeight) > 75 Then
     LocalFile=Server.MapPath(SavefullPath)
     TargetFile=Server.MapPath(SavefullPath)

    on error resume next

canjias=1


     Dim Jpeg 
     Set Jpeg = Server.CreateObject("Persits.Jpeg") 
     If -2147221005=Err then

canjias=0

 
     ' Response.Write("<script language='javascript'>alert('没有这个组件，请安装!');history.back();</script>") '检查是否安装AspJpeg组件 
      'Response.End() 
     End If 
     Jpeg.Open (LocalFile) '打开图片 
     If err.number then 

canjias=0

      'Response.Write("<script language='javascript'>alert('打开图片失败,请检查路径！');history.back();</script>")
      'Response.End() 
     End if 


if canjias=1 then
     Dim aa 
     aa=Jpeg.Binary '将原始数据赋给aa 
     '=========加文字水印================= 
     Jpeg.Canvas.Font.Color = shuiyin_z_color '水印文字颜色 
     Jpeg.Canvas.Font.Family = Arial '字体 
     Jpeg.Canvas.Font.Bold = false '是否加粗 
     Jpeg.Canvas.Font.Size = shuiyin_z_size '字体大小 
     Jpeg.Canvas.Font.ShadowColor = &H000000 '阴影色彩 
     Jpeg.Canvas.Font.ShadowYOffset = 1 
     Jpeg.Canvas.Font.ShadowXOffset = 1 
     Jpeg.Canvas.Brush.Solid = True 
     Jpeg.Canvas.Font.Quality = 10 ' '输出质量 


    ' Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-20,Jpeg.OriginalHeight-50,shuiyin_cont    '水印位置及文字 

     Jpeg.Canvas.PrintText 1,Jpeg.OriginalHeight-50,shuiyin_cont    '水印位置及文字 

     bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度 
     '============调整文字透明度================ 
     Set MyJpeg = Server.CreateObject("Persits.Jpeg") 
     MyJpeg.OpenBinary aa 
     Set Logo = Server.CreateObject("Persits.Jpeg") 
     Logo.OpenBinary bb 
     MyJpeg.DrawImage 0,0, Logo, 0.5 '0.3是透明度 
     cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了 
     'Response.BinaryWrite cc '将二进输出给浏览器 
     MyJpeg.Save (TargetFile) 
     set aa = nothing 
     set bb = nothing 
     set cc = nothing 
     Jpeg.Close 
     MyJpeg.Close 
     Logo.Close


end if


    End If
    '加水印

end if


end function



%>